COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "CRESAI"
C00004 00003	REAL SUBR XPP (INTEGER V)
C00005 00004	INTEGER SUBR CW (INTEGER X)START_CODE HLRZ 1,@XEND
C00007 00005	REAL XSUBR ATAN2(REAL Y,X)REAL XSUBR SQRT(REAL X)
C00008 00006	SUBR ALLIGN(ITG P1,P2)
C00010 00007	SUBR DPYMATES (ITG IMG)
C00011 00008	α MAIN EXECUTION
C00012 ENDMK
C⊗;
BEGIN "CRESAI"
	REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;

	REQUIRE "CRE" 	 LOAD_MODULE;
	REQUIRE "MKCON"  LOAD_MODULE;
	REQUIRE "CMPARE" LOAD_MODULE;
	REQUIRE "CREMEM" LOAD_MODULE;
	REQUIRE "CREIO"  LOAD_MODULE;
	REQUIRE "CREDPY" LOAD_MODULE;

	EXTERNAL INTEGER FILM;
	EXTERNAL SUBR CRE;

α DISPLAY ROUTINES;
	EXTERNAL SAFE INTEGER ARRAY DPYBUF[0:1];
	XSUBR DPYBIG (INTEGER I);
	XSUBR DPYBRT (INTEGER I);
	XSUBR AIVECT (INTEGER X,Y);
	XSUBR AVECT  (INTEGER X,Y);
	XSUBR DPYSET (INTEGER ARRAY BUF);
	XSUBR DPYOUT (INTEGER I);
	XSUBR DPYSST (STRING STR);
	XSUBR PLOTO (STRING STR);
	XSUBR DPYGON(INTEGER I);

	XSUBR CROP;
	XSUBR DPYIMG;

α INPUT/OUTPUT ROUTINES;
	XSUBR CREIN(STRING S);XSUBR CREOUT(STRING S);
	XSUBR TVDSKI(STRING S);XSUBR TVDSKO(STRING S);

α COMPARE ROUTINES;
	XSUBR MKLINT(INTEGER PGN);
REAL SUBR XPP (INTEGER V);
START_CODE MOVE 1,V;HRRZ 1,3(1);FSC 1,'225;FSBR 1,[144.0];END;

REAL SUBR YPP (INTEGER V);
START_CODE MOVE 1,V;HLRZ 1,3(1);FSC 1,'225;FSBR 1,[108.0];MOVNS 1;END;

	DEFINE FIX="'247000000000";

REAL SUBR XPP_(REAL X;INTEGER V);
START_CODE MOVE X;FADR[144.0];FIX '225000;MOVE 1,V;HRRM 3(1);END;

REAL SUBR YPP_(REAL Y;INTEGER V);
START_CODE MOVN Y;FADR[108.0];FIX '225000;MOVE 1,V;HRLM 3(1);END;

	INTEGER SUBR XWD(INTEGER X,Y);START_CODE MOVE 1,Y;HRL 1,X;END;
	INTEGER SUBR DIP(INTEGER X,Y);START_CODE MOVE 1,X;HRLM 1,Y;END;
	INTEGER SUBR DAP(INTEGER X,Y);START_CODE MOVE 1,X;HRRM 1,Y;END;

INTEGER SUBR CW (INTEGER X);START_CODE HLRZ 1,@X;END;
INTEGER SUBR CCW(INTEGER X);START_CODE HRRZ 1,@X;END;

INTEGER SUBR DAD(INTEGER X);START_CODE MOVE 1,X;HLRZ 1,1(1);END;
INTEGER SUBR SON(INTEGER X);START_CODE MOVE 1,X;HRRZ 1,1(1);END;

INTEGER SUBR TYPE(INTEGER X);START_CODE MOVE 1,X;HLRZ 1,2(1);END;
INTEGER SUBR RELOC(INTEGER X);START_CODE MOVE 1,X;HRRZ 1,2(1);END;

INTEGER SUBR ENDO(INTEGER X);START_CODE MOVE 1,X;HLRZ 1,3(1);END;
INTEGER SUBR EXO (INTEGER X);START_CODE MOVE 1,X;HRRZ 1,3(1);END;

INTEGER SUBR ALT (INTEGER X);START_CODE MOVE 1,X;HLRZ 1,4(1);END;
INTEGER SUBR NCNT(INTEGER X);START_CODE MOVE 1,X;HRRZ 1,4(1);END;

INTEGER SUBR NGON(INTEGER X);START_CODE MOVE 1,X;HLRZ 1,5(1);END;
INTEGER SUBR PGON(INTEGER X);START_CODE MOVE 1,X;HRRZ 1,5(1);END;

INTEGER SUBR NTIME(INTEGER X);START_CODE MOVE 1,X;HLRZ 1,6(1);END;
INTEGER SUBR PTIME(INTEGER X);START_CODE MOVE 1,X;HRRZ 1,6(1);END;

INTEGER SUBR NLINK(INTEGER X);START_CODE MOVE 1,X;HLRZ 1,7(1);END;
INTEGER SUBR PLINK(INTEGER X);START_CODE MOVE 1,X;HRRZ 1,7(1);END;
REAL XSUBR ATAN2(REAL Y,X);REAL XSUBR SQRT(REAL X);
REAL XSUBR SIN(REAL X);REAL XSUBR COS(REAL X);

REAL SUBR PXY(INTEGER X);START_CODE MOVE 1,X;HLLE 1,4(1);END;
REAL SUBR MXX(INTEGER X);START_CODE MOVE 1,X;HLLE 1,6(1);END;
REAL SUBR MYY(INTEGER X);START_CODE MOVE 1,X;HRLE 1,6(1);END;
REAL SUBR MZZ(INTEGER X);START_CODE MOVE 1,X;HRLE 1,4(1);END;
REAL SUBR AREA(INTEGER X);START_CODE MOVE 1,X;HRLE 1,1(1);END;
REAL SUBR PERM(INTEGER X);START_CODE MOVE 1,X;HLLE 1,1(1);END;

REAL SUBR PANG(INTEGER X);RETURN(0.5*ATAN2(2*PXY(X),MYY(X)-MXX(X)));
SUBR ALLIGN(ITG P1,P2);
BEGIN "ALLIGN"
	INTEGER S1,S2,V,V0;
	REAL C,S,SCALE,PHI;
	REAL XCM1,YCM1,XCM2,YCM2;

	DPYSET(DPYBUF);DPYGON(P1);DPYGON(P2);DPYOUT(0);

	MKLINT(P1);MKLINT(P2);
	S1←ALT(P1);S2←ALT(P2);

	PHI ← PANG(S2) - PANG(S1);
	C ← COS(PHI); S ← SIN(PHI);
	XCM1 ← XPP(S1); YCM1 ← YPP(S1);
	XCM2 ← XPP(S2); YCM2 ← YPP(S2);
	SCALE ← AREA(S2)/AREA(S1);

	V ← V0 ← SON(P1);
	DO BEGIN REAL X,Y;
		X ← (XPP(V) - XCM1)*SCALE;
		Y ← (YPP(V) - YCM1)*SCALE;
		XPP_(C*X-S*Y+XCM2,V);
		YPP_(S*X+C*Y+YCM2,V);
	END UNTIL V0 = (V←CCW(V));

	DPYSET(DPYBUF);DPYGON(P1);DPYGON(P2);DPYOUT(1);
		
END "ALLIGN";
SUBR DPYMATES (ITG IMG);
BEGIN "DPYMATES"
	ITG LVL0,LVL,PGN0,PGN,V0,V,U;
	DPYSET(DPYBUF);
		LVL0 ← SON(IMG);
		LVL ← CCW(LVL0);
	DO BEGIN
		PGN0 ← PGN ← SON(LVL);LVL←CCW(LVL);
	DO BEGIN
		V0 ← V ← SON(PGN);PGN←CCW(PGN);
		AIVECT(3.5*XPP(V),3.5*YPP(V));
	DO BEGIN
		V ← CCW(V);
		AVECT(3.5*XPP(V),3.5*YPP(V));
	END UNTIL V=V0;
	END UNTIL PGN=PGN0;
	END UNTIL LVL=LVL0;

	DPYOUT(1);
END "DPYMATES";
α MAIN EXECUTION;
BEGIN "MAIN"
	ITG IMG,LVL,PGN;
	ITG P1,P2,I1,I2;

	CROP;CREIN("TMP");

	I1 ← SON(FILM);
	I2 ← CCW(I1);

	P1 ← SON(CCW(SON(I1)));
	P2 ← SON(CCW(SON(I2)));

	ALLIGN(P1,P2);
	INCHRW;
	CRE;
END "MAIN";
END "CRESAI";